package Net::Coro::EV::Connect::Resolve::EVADNS;

use common::sense;
our $VERSION = 0.01;
our $_ISADNS;
BEGIN {
	our $_ISADNS = 1;
	eval{ require EV::ADNS};
	if ($@) {
		$_ISADNS = 0;
		warn "EV::ADNS is missed. domain names are resolved in synchronous mode. and IPv6 not supported. install EV::ADNS for the best performance.";
		
		sub EV::ADNS::s_nomemory {};
		sub EV::ADNS::s_unknownrrtype {};
		sub EV::ADNS::s_systemfail {};
		sub EV::ADNS::s_max_localfail {};
		sub EV::ADNS::s_timeout {};
		sub EV::ADNS::s_allservfail {};
		sub EV::ADNS::s_norecurse {};
		sub EV::ADNS::s_invalidresponse {};
		sub EV::ADNS::s_unknownformat {};
		sub EV::ADNS::s_max_remotefail {};
		sub EV::ADNS::s_rcodeservfail {};
		sub EV::ADNS::s_rcodeformaterror {};
		sub EV::ADNS::s_rcodenotimplemented {};
		sub EV::ADNS::s_rcoderefused {};
		sub EV::ADNS::s_rcodeunknown {};
		sub EV::ADNS::s_max_tempfail {};
		sub EV::ADNS::s_inconsistent {};
		sub EV::ADNS::s_prohibitedcname {};
		sub EV::ADNS::s_answerdomaininvalid {};
		sub EV::ADNS::s_answerdomaintoolong {};
		sub EV::ADNS::s_invaliddata {};
		sub EV::ADNS::s_max_misconfig {};
		sub EV::ADNS::s_querydomainwrong {};
		sub EV::ADNS::s_querydomaininvalid {};
		sub EV::ADNS::s_querydomaintoolong {};
		sub EV::ADNS::s_max_misquery {};
		sub EV::ADNS::s_nxdomain {};
		sub EV::ADNS::s_nodata {};
		sub EV::ADNS::s_max_permfail {};
		
		sub EV::ADNS::r_cname {};
		sub EV::ADNS::submit {};
		sub EV::ADNS::r_addr {};
		sub EV::ADNS::r_unknown {};
		sub EV::ADNS::s_ok {};
	}
}

use Socket;
use EV;
our $BINDIP = 0;
our $TIMEOUT = 10; 
our $MAX_CNAME_REDIRECT = 10;


sub new {
	my ($class) =@_;
	
	my $this ={};
	$this->{_TIMEOUT} = $TIMEOUT;
	$this->{_BINDIP} = $BINDIP;
	
	bless $this, $class;
	return $this;
}


sub resolve {
	die(__PACKAGE__." resolve: arguments count less then 3") if $#_ < 3;
	my ($this, $host, $port, $caller) = @_;
	$this->{_CALLER} = $caller;
	
	if (!$_ISADNS) {
		my $w;
		$w = EV::idle_ns sub {
			my ($name, $aliases, $addrtype, $length, @addrs) = gethostbyname($host) ;
			return $this->err("can't resolve domain name $name (!$)", 3) if !@addrs;
			$this->callback(inet_ntoa($addrs[0]), $port, ($addrtype == AF_INET6));
			undef $w;
		};
		$w->priority(EV::MAXPRI);
		$w->start;
		return;
	}
	
	
	# work around some idiotic adns rfc readings
	# thanks Marc Lehmann
	my $loop = $MAX_CNAME_REDIRECT; # follow cname chains up to this length
	my $qt = 0; # 0 - A record; 1 - AAAA (for ipv6) record;  2- CNAME record; 
	$this->{_DNS_HNDL} = sub {		
		my ($status, $expires, @ips) = @_;
		
		if ($status == EV::ADNS::s_prohibitedcname) {
			# follow cname chains
			if ($loop--) {
				$qt = 2;
				$this->{_WDNS} = EV::ADNS::submit ($host, EV::ADNS::r_cname, 0, $this->{_DNS_HNDL});
				return ;
			}
		}
		
		if ($status == EV::ADNS::s_ok and $qt == 2) {
			$host = $ips[0];
			$qt = 0;
			$this->{_WDNS} = EV::ADNS::submit ($host, EV::ADNS::r_addr, 0, $this->{_DNS_HNDL});
			return ;
		}
		
		if ($status == EV::ADNS::s_nodata and $qt == 0) {
			# ask for raw AAAA
			$qt = 1;
			$this->{_WDNS} = EV::ADNS::submit ($host, EV::ADNS::r_unknown | 28, 0, $this->{_DNS_HNDL});
			return;
		}
				
				
		if ($status != EV::ADNS::s_ok) {
			$this->err("dns error: ".dns_get_err($status), 3);
			return;
		}

		$this->callback($ips[0], $port, $qt);
	};
	
	my $ipv6 = $host =~ /:/s;
	if ($ipv6 or $host =~ /^[\d\.]+$/s) {
		my $w;
		$w = EV::idle_ns sub {
			$this->callback($host, $port, $ipv6);
			undef $w;
		};
		$w->priority(EV::MAXPRI);
		$w->start;
	} else {
		$this->{_WDNS} = EV::ADNS::submit $host, EV::ADNS::r_addr, 0, $this->{_DNS_HNDL};
	}
}




sub dns_get_err {
	my ($status) = @_;
	my $s_err = '';
	
	if    ($status == EV::ADNS::s_nomemory)				{$s_err='s_nomemory';} 
	elsif ($status == EV::ADNS::s_unknownrrtype)		{$s_err='s_unknownrrtype';}
	elsif ($status == EV::ADNS::s_systemfail)			{$s_err='s_systemfail';}
	elsif ($status == EV::ADNS::s_max_localfail)		{$s_err='s_max_localfail';} 
	elsif ($status == EV::ADNS::s_timeout)				{$s_err='s_timeout';}
	elsif ($status == EV::ADNS::s_allservfail)			{$s_err='s_allservfail';}
	elsif ($status == EV::ADNS::s_norecurse)			{$s_err='s_norecurse';} 
	elsif ($status == EV::ADNS::s_invalidresponse)		{$s_err='s_invalidresponse';} 
	elsif ($status == EV::ADNS::s_unknownformat)		{$s_err='s_unknownformat';} 
	elsif ($status == EV::ADNS::s_max_remotefail)		{$s_err='s_max_remotefail';} 
	elsif ($status == EV::ADNS::s_rcodeservfail)		{$s_err='s_rcodeservfail';} 
	elsif ($status == EV::ADNS::s_rcodeformaterror)		{$s_err='s_rcodeformaterror';} 
	elsif ($status == EV::ADNS::s_rcodenotimplemented)	{$s_err='s_rcodenotimplemented';} 
	elsif ($status == EV::ADNS::s_rcoderefused)			{$s_err='s_rcoderefused';} 
	elsif ($status == EV::ADNS::s_rcodeunknown)			{$s_err='s_rcodeunknown';} 
	elsif ($status == EV::ADNS::s_max_tempfail)			{$s_err='s_max_tempfail';} 
	elsif ($status == EV::ADNS::s_inconsistent)			{$s_err='s_inconsistent';} 
	elsif ($status == EV::ADNS::s_prohibitedcname)		{$s_err='s_prohibitedcname';} 
	elsif ($status == EV::ADNS::s_answerdomaininvalid)	{$s_err='s_answerdomaininvalid';} 
	elsif ($status == EV::ADNS::s_answerdomaintoolong)	{$s_err='s_answerdomaintoolong';} 
	elsif ($status == EV::ADNS::s_invaliddata)			{$s_err='s_invaliddata';} 
	elsif ($status == EV::ADNS::s_max_misconfig)		{$s_err='s_max_misconfig';} 
	elsif ($status == EV::ADNS::s_querydomainwrong)		{$s_err='s_querydomainwrong';} 
	elsif ($status == EV::ADNS::s_querydomaininvalid)	{$s_err='s_querydomaininvalid';} 
	elsif ($status == EV::ADNS::s_querydomaintoolong)	{$s_err='s_querydomaintoolong';} 
	elsif ($status == EV::ADNS::s_max_misquery)			{$s_err='s_max_misquery';} 
	elsif ($status == EV::ADNS::s_nxdomain)				{$s_err='s_nxdomain';} 
	elsif ($status == EV::ADNS::s_nodata)				{$s_err='s_nodata';} 
	elsif ($status == EV::ADNS::s_max_permfail)			{$s_err='s_max_permfail';} 
	else 												{$s_err = 'unknown: $status';}
	
	return $s_err;
}

########## COMMON ARCHITECTURAL METHODS AND EVENT HANDLERS ###########
# no needed:
#sub onwritten
#sub onclose
#sub onbreak

sub callback {
	my ($this, @resp) = @_;
	undef $this->{_ERRM};
	undef $this->{_ERRC};
	(delete $this->{_CALLER})->onresolve(@resp);
}

sub err {
	my ($this, $msg, $code) = @_;
	
	$this->{_ERRM} = $msg;
	$this->{_ERRC} = $code;
	$this->close;
	(delete $this->{_CALLER})->onresolve();
}



sub close {
	my ($this) = @_;
	delete $this->{_DNS_HNDL};
	(delete $this->{_WDNS})->cancel if defined $this->{_WDNS};
}

sub stop {
	my ($this) = @_;
	$this->close();
	delete $this->{_CALLER};
}


########### COMMON PROPIRTIES ######################
sub errc {$_[0]->{_ERRC}}
sub errm {$_[0]->{_ERRM}}

sub id {	
	my ($this, $id) = @_;
	if (defined $id) {
		$this->{_ID} = $id;
	}
	$this->{_ID};
}

sub timeout {
	my ($this, $val) = @_;	
	$this->{_TIMEOUT} = $val if defined $val;
	$this->{_TIMEOUT};
}

sub bindip {
	my ($this, $val) = @_;	
	$this->{_BINDIP} = $val if defined $val;
	$this->{_BINDIP};
}
1;